PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/hash.com/GENTABLE.PAS

Pascal/Delphi Source File | 1989-09-26 | 5.5 KB | 252 lines

Unit GenTable;   {Generic Hash Table}
{$B-}
        {Guarantee Short-Circuit Boolean evaluation}

{ Implements a String-keyed Hash Table of Datum Objects }

{ As currently configured (Compare and UpString NOT used), hashing is     }
{ case-sensitive. Using these functions will remove this case-sensitivity,}
{ but will slow performance somewhat.  The functions are commented off,   }
{ the places where they must be used are marked by comments which all     }
{ begin like this: "{SUBST:".                                             }


INTERFACE

Uses GenDatum;

Const
  MaxEntry = 17;

Type

  HPtr      = ^EntryRec;

  EntryRec  = Object (Datum)

             Key  : String;
             Next : HPtr;
{
  (* Applicable Datum Methods Inherited *)

             Procedure Set_Data (Var Input_Data; Size : Word);
             Procedure Get_Data (Var Output_Data; Size : Word);

  (* End Applicable Datum Methods *)
}

             Procedure Create (TheKey : String);
             Procedure Link (NewRec : EntryRec);
             Procedure Destroy;

           End;


  HTable = Object

             Entry : Array[0..MaxEntry-1] of HPtr;
             Used  : Array[0..MaxEntry-1] of Boolean;

             Procedure Create (DataSize : Word);
             Procedure Enter (E : EntryRec; Var Duplicate : Boolean);
             Procedure Retrieve (TheKey : String; Var Found : Boolean;
                                 Var E : EntryRec);
             Procedure Destroy;

           End;


IMPLEMENTATION

(************************************************************************)

Procedure EntryRec.Create (TheKey : String);
Begin
  Datum.Create;
  Next := Nil;
  Key := TheKey
End;

Procedure EntryRec.Link (NewRec : EntryRec);
Begin
  New (Next);
  Next^ := NewRec
End;

Procedure EntryRec.Destroy;
Begin
  Key := '';
  Datum.Destroy
End;

(************************************************************************)

Procedure HTable.Create (DataSize : Word);
Var
  I : Word;
Begin
  For I := 0 to MaxEntry-1 do
    Begin
      New (Entry[I]);
      Entry[I]^.Create('');
      Entry[I]^.Next := Nil;
      Entry[I]^.Init (DataSize);
      Used[I] := False
    End
End;

{

(* Function UpString is only needed to remove case-sensitivity *)

Function UpString (Str : String) : String;
Var
  I : Byte;
  S : String;
Begin
  S := '';
  For I := 1 to Length (Str) do S := S + UpCase (Str[I])
End;
}

Function Hash (TheString : String) : Word;

{ Returns a Number in the Range 0..MaxEntry-1 }

Var
  Temp : Word;
  I    : Word;

{SUBST: Use a temporary variable as follows:

  TStr := UpString (TheString);

  and then substitute TStr for TheString in remaining code
  for Function Hash.}

Begin
  Temp := 0;
  For I := 1 to Length(TheString) do Temp := Temp + (Ord(TheString[I]));
  Hash := Temp MOD (MaxEntry)
End;

{

(*
   Function Compare is only needed if you can NOT guarantee that all keys
   will be of the same case.

   The four places where Compare must be used are commented, starting
   with "{SUBST:"
*)

Function Compare (Str1,Str2 : String) : Boolean;
Var
  S1,S2 : String;
  I     : Word;
Begin
  If Length(Str1) <> Length(Str2) Then
    Compare := False
  Else
    Begin
      S1 := UpString (Str1);
      S2 := UpString (Str2);
      Compare := (S1 = S2)
    End
End;

}

Procedure HTable.Enter (E : EntryRec; Var Duplicate : Boolean);
Var
  Temp  : HPtr;
  Ndex  : Word;
  Done  : Boolean;
Begin
  Duplicate := False;
  Ndex := Hash (E.Key);
  If Not Used[Ndex] Then
    Begin
      Entry[Ndex]^ := E;
      Used[Ndex] := True
    End
  Else
    Begin
      Done := False;
      Temp := Entry[Ndex];
      While Not Done do
        Begin
          If (Temp^.Key = E.Key) Then  {SUBST: Compare (Temp^.Key,E.Key)}
            Begin
              Duplicate := True;
              Done := True
            End
          Else
            Begin
              While Temp^.Next <> Nil do
                Begin
                  Temp := Temp^.Next;
                  If (Temp^.Key = E.Key) Then Duplicate := True

                      {SUBST: Compare (Temp^.Key,E.Key)}
                End;
              Done := True
            End
        End;
      If Not Duplicate Then Temp^.Link (E)
    End
End;

Procedure HTable.Retrieve (TheKey : String; Var Found : Boolean;
                           Var E : EntryRec);
Var
  Temp : HPtr;
  Ndex : Word;
  Done : Boolean;
Begin
  Found := False;
  Ndex := Hash (TheKey);
  If Not Used[Ndex] Then Exit {Found = False}
  Else
    Begin
      Done := False;
      Temp := Entry[Ndex];
      While (Not Done) and (Not (Temp^.Key = TheKey)) do

                           {SUBST: Compare (Temp^.Key,E.Key)}

        If Temp^.Next = Nil Then Done := True
        Else Temp := Temp^.Next;
      If Not (Temp^.Key = TheKey) Then Exit {Found = False}

                          {SUBST: Compare (Temp^.Key,E.Key)}
      Else
        Begin
          E := Temp^;
          Found := True
        End
    End
End;

Procedure HTable.Destroy;
Var
  Temp1 : HPtr;
  Temp2 : HPtr;
  Ndex  : Word;
Begin
  For Ndex := 0 to MaxEntry-1 do
    Begin
      While Entry[Ndex] <> Nil do
        Begin
          Temp1 := Entry[Ndex];
          Temp2 := Temp1^.Next;
          Dispose (Temp1);
          Entry[Ndex] := Temp2
        End
    End
End;

(************************************************************************)

BEGIN
END.